home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / UTILITY / COMPARE.lisp next >
Encoding:
Text File  |  1990-06-25  |  5.8 KB  |  119 lines  |  [TEXT/CCL ]
  1. ; (c) Copyright 1990 by University of Massachusetts. All rights reserved.
  2. ; This software was conceived, designed, and written by Dan Suthers 
  3. ; while supported by the National Science Foundation under grant number
  4. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  5. ; CA.  Partial support was also received from the Office of Naval Research
  6. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  7. ; Mr. Suthers created this software under his own initiative while in an 
  8. ; academic relationship with the University of Massachusetts.  The above
  9. ; copyright notice was a condition placed by University lawyers on approval
  10. ; of distribution of this software by Apple Computer, and is not meant to
  11. ; imply that this software was created in an employment or "work for hire"
  12. ; relationship between the University and Mr. Suthers.
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; File:         COMPARE.lisp
  15. ; Author:       Dan Suthers
  16. ; Created:      16-Jun-88 10:42:08
  17. ; Modified:     22-Jun-90 02:08:45 (Dan Suthers)
  18. ; Language:     Common Lisp
  19. ; Package:      UTILS
  20. ;
  21. ; Description:  Alternate comparison functions (eg more lenient EQUAL).
  22. ;
  23. ; (c) Copyright 1988, by Daniel D. Suthers
  24. ;                        Department of Computer and Information Science
  25. ;                        University of Massachusetts
  26. ;                        Amherst, Massachusetts 01003
  27. ;
  28. ; This software was conceived, designed, and written by Dan Suthers 
  29. ; while supported by the National Science Foundation under grant number
  30. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  31. ; CA.  Partial support was also received from the Office of Naval Research
  32. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  33. ; I wish to acknowledge the generous support of Beverly Woolf, who obtained 
  34. ; the above grants and encouraged me to pursue my own research interests in
  35. ; her lab.  This work would not have been possible without the resources and
  36. ; stimulating environment of the Computer and Information Science department.
  37. ;
  38. ; Permission to use, modify, and distribute this software is granted subject 
  39. ; to the following restrictions and understandings:
  40. ; 1. The file header, including this notice, shall be retained, and may be
  41. ;    extended to include documentation of modifications to the software.
  42. ; 2. This material is for nonprofit educational and research purposes only.
  43. ;    Users are requested, but not required, to inform Mr. Suthers of any 
  44. ;    noteworthy uses of this software.
  45. ; 3. Mr. Suthers and the University of Massachusetts make no warrantee or
  46. ;    representation that the operation of this software will be error free,
  47. ;    and are under no obligation to provide any services.
  48. ; 4. Any user of such software agrees to indemnify and hold harmless Mr.
  49. ;    Suthers and the University of Massachusetts from all claims arising 
  50. ;    out of the use or misuse of this software, or arising out of any 
  51. ;    accident, injury, or damage whatsoever, and from all costs, counsel
  52. ;    fees, and liabilities incurred in or about any such claim, action, or
  53. ;    proceeding brought thereon.
  54. ; 5. All materials and reports developed as a consequence of the use of 
  55. ;    this software shall duly acknowledge such use, in accordance with
  56. ;    the usual standards of acknowledging credit in academic research.
  57. ;
  58. ; Status:       Done and tested.
  59. ;
  60. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  61.  
  62. (in-package :UTILS)
  63.  
  64. (export '(
  65.           alike
  66.           orderp
  67.           ))
  68.  
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70.  
  71. (defun ALIKE (x y) 
  72.   "alike <x> <y>                                                    [Function]
  73.   A more permissive equality test:
  74.    - Floats numeric arguments.
  75.    - Ignores packages when comparing atoms.
  76.    - Ignores case when comparing strings.
  77.    - Compares atoms of different types by converting to print names.
  78.    - Recursively applies the above to lists.
  79.    - Defaults to EQUALP if an argument is not an atom or list."
  80.   (cond ((and (numberp x) (numberp y)) (= (float x) (float y)))
  81.         ((and (atom x) (atom y))
  82.          (string-equal 
  83.            (if (numberp x) (princ-to-string x) (string x))
  84.            (if (numberp y) (princ-to-string y) (string y)) ))
  85.         ((and (consp x) (consp y))
  86.          (and (alike (first x) (first y))
  87.               (alike (rest x)  (rest y)) ))
  88.         ((equalp x y)) ))
  89.  
  90. (defun ORDERP (x y) 
  91.   "orderp <x> <y>                                                   [Function]
  92.   Defines a lexical ordering on a variety of LISP objects:
  93.    - Numbers are floated before comparing to each other.
  94.    - Case is ignored in strings.
  95.    - Atoms are compared by printname (ignores packages).
  96.    - Mixtures of Atoms, Strings, and Numbers are compared by
  97.      print names, using the above conventions.
  98.    - Lists are compared lexically (element wise & recursively);
  99.    - Lists are always 'greater than' atomic types.
  100.    Always returns NIL if given any other type.  See also ALIKE."
  101.   (cond ((and (numberp x) (numberp y)) ; printnames don't work here!
  102.          (< x y))
  103.         ((and (atom x) (atom y)) ; compare atomic types by printnames
  104.          (string-lessp 
  105.            (if (numberp x) (princ-to-string (float x)) (string x))
  106.            (if (numberp y) (princ-to-string (float y)) (string y)) ))
  107.         ((and (consp x) (consp y)) ; compare lists lexically by elements
  108.          (cond ((orderp (first x) (first y)) T)
  109.                ((alike  (first x) (first y))
  110.                 (orderp (rest x)  (rest y)) )
  111.                (T NIL)))
  112.         ((and (atom x) (consp y)) T) ; atomic types less than lists
  113.         (T NIL))) ; cannot compare
  114.  
  115. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  116. (provide :COMPARE)
  117. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  118. ;;; EOF
  119.